Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/error_hn/rdblib/rdblib.bas

BASIC Source File | 1995-04-20 | 26.0 KB | 674 lines

' Common Subroutine & Functions Module
' Provided by:
'    Royce D. Bacon
'    RDB Systems
'    8942 W. Lawrence Ave.
'    Milwaukee, WI  53225
'    Compuserve ID: 70042,1001
'
' You may use these routines in your own programs and
' distribute them or the compiled versions of them
' with your programs.  However, you may not distribute
' these routines alone for profit.
'
' Payment for these routines is not required, but will
' always be appreciated.
'
Option Explicit

Global RB_systemname As String
Global RB_version As String
Global RB_Erraction As Integer
Global Const RB_GRAY = &HC0C0C0
' Constants, etc. for screen capture/print function
Global Const SW_HIDE = 0
Global Const SW_SHOW = 5
Declare Function ShowWindow Lib "User" (ByVal hwnd As Integer, ByVal nCmdShow As Integer) As Integer

' Declares for log file routines
Global RB_LogFileOpen As Integer   ' Indication if log file is open
Global RB_DBLog As database
Global RB_TblErrorLog As table
Global RB_TblPerformanceLog As table
Global RB_LogPerformanceData As Integer     ' Indicates if should log performance data
Global RB_UserName As String            ' User name from ini file
Global Const RB_STARTTASK = 1           ' Log start of task
Global Const RB_ENDTASK = 2             ' Log end of task



' Windows function declarations

Declare Function GetModuleUsage Lib "KERNEL" (ByVal InstanceID%) As Integer

'******************************************************
'           DLL Declarations                          *
'******************************************************
Type POINTAPI
    X As Integer
    Y As Integer
End Type

Declare Function LoadMenu Lib "User" (ByVal hInstance As Integer, ByVal lpString As String) As Integer
Declare Function GetMenu Lib "User" (ByVal hwnd As Integer) As Integer
Declare Function SetMenu Lib "User" (ByVal hwnd As Integer, ByVal hMenu As Integer) As Integer
Declare Function HiliteMenuItem Lib "User" (ByVal hwnd As Integer, ByVal hMenu As Integer, ByVal wIDHiliteItem As Integer, ByVal wHilite As Integer) As Integer
Declare Function GetMenuString Lib "User" (ByVal hMenu As Integer, ByVal wIDItem As Integer, ByVal lpString As String, ByVal nMaxCount As Integer, ByVal wFlag As Integer) As Integer
Declare Function GetMenuState Lib "User" (ByVal hMenu As Integer, ByVal wId As Integer, ByVal wFlags As Integer) As Integer
Declare Sub DrawMenuBar Lib "User" (ByVal hwnd As Integer)
Declare Function GetSystemMenu Lib "User" (ByVal hwnd As Integer, ByVal bRevert As Integer) As Integer
Declare Function GetSubMenu Lib "User" (ByVal hMenu As Integer, ByVal nPos As Integer) As Integer
Declare Function GetMenuItemID Lib "User" (ByVal hMenu As Integer, ByVal nPos As Integer) As Integer
Declare Function GetMenuItemCount Lib "User" (ByVal hMenu As Integer) As Integer
Declare Function TrackPopupMenu Lib "User" (ByVal hMenu As Integer, ByVal wFlags As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nReserved As Integer, ByVal hwnd As Integer, lpReserved As Any) As Integer
Declare Function InsertMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpNewItem As Any) As Integer
Declare Function AppendMenu Lib "User" (ByVal hMenu As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpNewItem As Any) As Integer
Declare Function ModifyMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpString As Any) As Integer
Declare Function RemoveMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
Declare Function DeleteMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer

Declare Function ExitWindows Lib "User" (ByVal dwReserved As Long, wReturnCode) As Integer
Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer, ByVal nIndex As Integer) As Integer
Declare Function GetActiveWindow Lib "User" () As Integer
Declare Sub GetCursorPos Lib "User" (lpPoint As POINTAPI)
Declare Function GetSystemMetrics Lib "User" (ByVal nIndex As Integer) As Integer
Declare Function GetFocus Lib "User" () As Integer
Declare Function SetActiveWindow Lib "User" (ByVal hwnd As Integer) As Integer
Declare Function GetModuleHandle Lib "Kernel" (ByVal lpModuleName As String) As Integer
Declare Function GetModuleFileName Lib "Kernel" (ByVal hModule As Integer, ByVal lpFileName As String, ByVal nSize As Integer) As Integer
Declare Function GetFreeSpace Lib "Kernel" (ByVal wFlags As Integer) As Long

'Indices for GetSystemMetrics
Global Const SM_CXSIZE = 30
Global Const SM_CYSIZE = 31

'Indices for GetDeviceCaps
Global Const HORZRES = 8    '  Horizontal width in pixels
Global Const VERTRES = 10   '  Vertical width in pixels

'Menu flags for Add/Check/EnableMenuItem()
Global Const MF_INSERT = &H0
Global Const MF_CHANGE = &H80
Global Const MF_APPEND = &H100
Global Const MF_DELETE = &H200
Global Const MF_REMOVE = &H1000

Global Const MF_BYCOMMAND = &H0
Global Const MF_BYPOSITION = &H400

Global Const MF_SEPARATOR = &H800

Global Const MF_ENABLED = &H0
Global Const MF_GRAYED = &H1
Global Const MF_DISABLED = &H2

Global Const MF_UNCHECKED = &H0
Global Const MF_CHECKED = &H8
Global Const MF_USECHECKBITMAPS = &H200

Global Const MF_STRING = &H0
Global Const MF_BITMAP = &H4
Global Const MF_OWNERDRAW = &H100

Global Const MF_POPUP = &H10
Global Const MF_MENUBARBREAK = &H20
Global Const MF_MENUBREAK = &H40

Global Const MF_UNHILITE = &H0
Global Const MF_HILITE = &H80

Global Const MF_SYSMENU = &H2000
Global Const MF_HELP = &H4000
Global Const MF_MOUSESELECT = &H8000

'  Menu item resource format
Type MENUITEMTEMPLATEHEADER
    versionNumber As Integer
    offset As Integer
End Type

Type MENUITEMTEMPLATE
    mtOption As Integer
    mtID As Integer
    mtString As Long
End Type

Global Const MF_END = &H80

'  System Menu Command Values
Global Const SC_SIZE = &HF000
Global Const SC_MOVE = &HF010
Global Const SC_MINIMIZE = &HF020
Global Const SC_MAXIMIZE = &HF030
Global Const SC_NEXTWINDOW = &HF040
Global Const SC_PREVWINDOW = &HF050
Global Const SC_CLOSE = &HF060
Global Const SC_VSCROLL = &HF070
Global Const SC_HSCROLL = &HF080
Global Const SC_MOUSEMENU = &HF090
Global Const SC_KEYMENU = &HF100
Global Const SC_ARRANGE = &HF110
Global Const SC_RESTORE = &HF120
Global Const SC_TASKLIST = &HF130

'******************************************************
'*          OpenFile Modes                            *
'******************************************************
Global Const REPLACEFILE = 0
Global Const READFILE = 1
Global Const APPENDFILE = 2
Global Const RANDOMFILE = 3
Global Const BINARYFILE = 4


'**************************************************
' Declares for screen grabber function
'**************************************************
Type lrect
    Left As Integer
    Top As Integer

    right As Integer
    bottom As Integer
End Type
Declare Function GetDesktopWindow Lib "user" () As Integer
Declare Function GetDC Lib "user" (ByVal hwnd%) As Integer

' Note: The following Declare should be on one line:
Declare Function BitBlt Lib "GDI" (ByVal hDestDC%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&) As Integer
Declare Function ReleaseDC Lib "User" (ByVal hwnd As Integer, ByVal hDC As Integer) As Integer

Declare Sub GetWindowRect Lib "User" (ByVal hwnd%, lpRect As lrect)
Global TwipsPerPixel As Single


'Other API Declarations For Sound
Declare Sub MessageBeep Lib "User" (ByVal wType As Integer)
Declare Sub SndPlaySound Lib "MMSystem.dll" (ByVal WavFile$, ByVal wFlags As Integer)

Declare Function GetPrivateProfileInt Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer
Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer

Function RB_Format_Phone_Num (psPhone_Num)
' This routine will format a phone number
' The routine always returns a right justified 12 character value
' Valid input formats and resulting outputs are (_ = blank):
'   nnnnnnn - formatted as ____nnn-nnnn
'   nnnnnnnnnn - formatted as nnn-nnn-nnnn
'   All other inputs will be returned as entered, but right justified
    Dim sWkPhone_Num As String

    sWkPhone_Num = Trim$(psPhone_Num)
    Select Case True
        Case Len(sWkPhone_Num) = 7      ' number w/o area code (nnnnnnn) format
            RB_Format_Phone_Num = "    " & Left$(sWkPhone_Num, 3) & "-" & Right$(sWkPhone_Num, 4)
        Case Len(sWkPhone_Num) = 10     ' number w/area code (nnnnnnnnnn) format
            RB_Format_Phone_Num = Left$(sWkPhone_Num, 3) & "-" & Mid$(sWkPhone_Num, 4, 3) & "-" & Right$(sWkPhone_Num, 4)
        Case Else
            RB_Format_Phone_Num = Right$(Space$(12) & sWkPhone_Num, 12)

    End Select

End Function

Function RB_Rjustify (pnumber, pformat As String, pcol) As Single
    ' ========================= RB_Rjustify ====================
    ' Will print a number passed as parameter 1
    ' according to the format passed as parameter 2
    ' right justified on the column passed as parameter 3
    ' Returns the leftmost column position where printing started
    '
    ' Example:
    ' leftcol = RB_Rjustify(200, "###,###.##", 40)
    ' will print "    200.00" with the rightmost 0 at column 40
    '
    Dim rbpos As Single
    Dim rbstr As String
    Dim rblen As Single
    rbstr = Format$(pnumber, pformat)
    rblen = printer.TextWidth(rbstr)
    rbpos = pcol - rblen
    printer.CurrentX = rbpos
    printer.Print rbstr;
    RB_Rjustify = rbpos

End Function

Sub RB_SetLogOptions ()
    RB_CloseLog
    RBLogOptions.Show MODAL
    RB_OpenLog

End Sub

Function RB_StatusMsg (pTag) As String
    ' Return status line portion of tag property
    If InStr(1, pTag, "|") = 0 Then     ' No | separator
        RB_StatusMsg = pTag                ' Use full string
    Else
        RB_StatusMsg = Mid$(pTag, InStr(1, pTag, "|") + 1)
    End If

End Function

Function RB_Text_Format (instring As String, pwidth As Long)
    ' ==================== RB_Text_Format ===================
    ' Will return a string variable passed as parameter 1
    ' formatted to print with a line length of parameter 2
    ' It will break each line at the end of a word
    '
    ' Example:
    ' newstring = RB_Text_Format(oldstring, 65)
    ' Printer.Print newstring
    ' will print the contents of oldstring as 65 character lines
    '
    Dim startpos As Integer, nextrtn As Integer, nextspace As Integer
    Dim svstartpos As Integer
    Dim svstatpos As Integer, svwkstring As String, wkinstring As String
    Dim wkstring As String, outstring As String, gotstring As Integer
    outstring = ""
    wkinstring = Trim$(instring)
    nextrtn = 0
    startpos = 1
    Do While startpos < Len(wkinstring)
        gotstring = False
        nextrtn = InStr(startpos, wkinstring, Chr$(13))
        If nextrtn > 0 Then
            wkstring = Mid$(wkinstring, startpos, nextrtn - startpos + 1)
            ' Check for string less than 400 characters because long
            ' strings cause an overflow error and definitely won't fit
            ' on a single line
            If Len(wkstring) < 400 Then
                If printer.TextWidth(wkstring) < pwidth Then
                    outstring = outstring + wkstring
                    startpos = nextrtn + 2
                    gotstring = True
                End If
            End If
        End If
        If Not gotstring Then
            wkstring = ""
            Do
                svwkstring = wkstring
                svstartpos = startpos
                nextrtn = InStr(startpos, wkinstring, " ")
                If nextrtn = 0 Then
                    wkstring = wkstring + Mid$(wkinstring, startpos)
                    svwkstring = wkstring
                    startpos = Len(wkinstring) + 1
                    svstartpos = startpos
                Else
                    wkstring = wkstring + Mid$(wkinstring, startpos, nextrtn - startpos + 1)
                    startpos = nextrtn + 1
                End If
            Loop While printer.TextWidth(wkstring) <= pwidth And startpos <= Len(wkinstring)
            startpos = svstartpos
            outstring = outstring + svwkstring + Chr$(13) + Chr$(10)
        End If
    Loop
    RB_Text_Format = outstring


End Function

Function RB_Validate_Date (cdate As Control) As Integer
    ' ================= RB_Validate_Date =====================
    ' validates date contained in control passed as parameter 1
    ' will return True if input is valid date, the string "__/__/__" or null
    ' will display a msgbox with an "Enter a valid data" msg and return False
    '      if the input date is invalid
    '
    ' Example:
    ' TxtDate_LostFocus
    '   IF Not RB_Validate_Date(TxtDate) then
    '       Date.setfocus
    '   End If
    '
    Dim wk_date As String
    wk_date = cdate.Text
    If Len(wk_date) = 6 And InStr(1, wk_date, "/") = 0 Then
        wk_date = Left$(wk_date, 2) & "/" & Mid$(wk_date, 3, 2) & "/" & Right$(wk_date, 2)
        cdate.Text = wk_date
    End If
    If wk_date = "__/__/__" Or wk_date = "" Then
        RB_Validate_Date = True
        cdate.Text = ""
    ElseIf Not IsDate(wk_date) Then
        Beep
        MsgBox "Enter a valid date", , "Date Entry Error"
        RB_Validate_Date = False
    Else
        RB_Validate_Date = True
    End If

End Function

Sub ReadIni (AppName$, KeyName$, nDefault, DefaultStr$, ReturnStr$, Numeric%, IniFileName$)
'Note: IniFile should be in Windows Directory

' Example Calling Code to Read Numeric Variable ------------------------------------------------------------------------------
    'IniFileName$ = "MyINI.INI"        'name of ini file
    'AppName$ = "MyApp"             'Name of application or section heading
    'KeyName$ = "MyNumber"          'Keyword or variable name
    'nDefault = 0                   'Default numeric value (for numeric variables)
    'Numeric%=TRUE                  'Tell it we are looking for numeric value
    'ReadIni AppName$, KeyName$, nDefault, DefaultStr$, ReturnStr$, Numeric%, IniFileName$

' Example Calling Code to Read String Variable ------------------------------------------------------------------------------
    'IniFileName$ = "MyINI.INI"        'name of ini file
    'AppName$ = "MyApp"             'Name of application or section heading
    'KeyName$ = "MyString"          'Keyword or variable name
    'DefaultStr$ = "DefaultString"  'Default string        (for String variables)
    'Dim RetStr As String * 255     'Create an empty string to be filled
    'nSize% = 255                   'uncertain - possibly length of fill string
    'Numeric%=FALSE                 'Tell it we are looking for a string
    'ReadIni AppName$, KeyName$, nDefault, DefaultStr$, ReturnStr$, Numeric%, IniFileName$


' Read data from Private Profile (.ini) File
    Dim nSize%, lenRetString%

    If Numeric% Then    'we are looking for integer input
        Numeric% = GetPrivateProfileInt(AppName$, KeyName$, nDefault, IniFileName$)
    Else
        Dim RetStr As String * 255 'Create an empty string to be filled
        nSize% = 255               'uncertain - possibly length of fill string
        lenRetString% = GetPrivateProfileString(AppName$, KeyName$, DefaultStr$, RetStr$, nSize%, IniFileName$)
        ReturnStr$ = Left$(RetStr$, lenRetString%)

    End If


End Sub

Sub SaveIni (AppName$, IniFileName$, KeyName$, NewVal$)

    ' Update INI file

'Note: IniFile should be in Windows Directory

'Example calling Code to create or update ini -------------------------------------------------------------------------------------
    'IniFileName$ = "MyINI.INI"        'name of ini file
    'AppName$ = "MyApp"             'Name of application or section heading
    'KeyName$ = "MyNumber"          'Keyword or variable name
    'NewVal$="MyNewValue"           'if Numeric value convert it to string
    'SaveIni AppName$, IniFileName$, KeyName$, NewVal$

    Dim ResultCode%

    ResultCode% = WritePrivateProfileString(AppName$, KeyName$, NewVal$, IniFileName$)
    If ResultCode% = 0 Then
        Beep
        MsgBox "Error updating INI file!", 16, "ERROR!"
    End If

End Sub

Sub ShellAndWait (CommandString$)
  ' ============== ShellAndWait =====================
  ' Will start (via Shell Function) the command passed as parameter 1
  ' and wait until the command has completed and the window closed
  '
  ' Example:
  ' ShellAndWait("COPY A.TXT B.TXT")
  ' B.TXT will be available now
  '

  Dim ID%, X%

  ID% = Shell(CommandString$, 3)
  Do
    X% = DoEvents()
  Loop Until GetModuleUsage(ID%) = 0

End Sub

Sub Form3D (formname As Form)
   ' This code came from Visual Basic Tips And Techniques 94
   ' Tip Submitted By: Matej Nastran
   ' Modified to set 3-D based upon control type instead of tag = 3-D
   Dim drkgray As Long, fullwhite As Long
   Dim i As Integer, dw As Integer, Do3D As Integer
   Dim ctop As Integer, cleft As Integer, cright As Integer, cbottom As Integer

    ' Outline a form's text and combobox controls for 3D look

    Dim cname As Control

    drkgray = RGB(128, 128, 128)
    fullwhite = RGB(255, 255, 255)

    dw = formname.DrawWidth
    formname.DrawWidth = 1      'this suits me best
    For i = 0 To (formname.Controls.Count - 1)
        Set cname = formname.Controls(i)
        If TypeOf cname Is TextBox Then
            Do3D = True
        ElseIf TypeOf cname Is ComboBox Then
            Do3D = True
        Else
            Do3D = False
        End If
        If Do3D Then
            ctop = cname.Top - Screen.TwipsPerPixelY
            cleft = cname.Left - Screen.TwipsPerPixelX
            cright = cname.Left + cname.Width
            cbottom = cname.Top + cname.Height
            formname.Line (cleft, ctop)-(cright, ctop), drkgray
            formname.Line (cleft, ctop)-(cleft, cbottom), drkgray
            formname.Line (cleft, cbottom)-(cright, cbottom), fullwhite
            formname.Line (cright, ctop)-(cright, cbottom), fullwhite
        End If
    Next i
    formname.DrawWidth = dw
End Sub

Sub RB_Center (str_to_print As String, line_no, skip_line As Integer)
    ' ============= RB_Center ==============================
    ' Will center a string passed as parameter 1
    ' on printer line passed as parameter 2 or current line if parameter 2 = 0
    ' Will skip to next line if parameter 3 = true
    ' e.g. RB_Center "This String Will Be Centered On Line 3", 3, true
    '
    Dim col_to_print_at As Single
    col_to_print_at = ((printer.ScaleWidth - printer.TextWidth(str_to_print)) / 2) + printer.ScaleLeft
    printer.CurrentX = col_to_print_at
    If line_no <> 0 Then
        printer.CurrentY = line_no
    End If
    If skip_line Then
        printer.Print str_to_print
    Else
        printer.Print str_to_print;
    End If

End Sub

Sub RB_CloseLog ()
    On Error Resume Next
    RB_TblPerformanceLog.Close
    RB_TblErrorLog.Close
    RB_DBLog.Close

End Sub

Function RB_ErrorHandler (pform As String, proutine As String) As Integer
    ' =================== RB_ErrorHandler =========================
    ' Displays dialog indicating error and allows user to
    ' print problem report form, obtain help on error condition,
    ' abort program, retry the function, or ignore the error
    '
    ' Example of using RB_ErrorHandler
    ' erraction = RB_ErrorHandler("FormName", "Routine")
    ' Select Case erraction
    ' Case 1
    '     Resume 0      ' Retry option selected
    ' Case 2
    '     Resume Next   ' Ignore option selected
    ' End Select
    '
    ' To use in your projects include RDBLIB.BAS, RBERRFRM.FRM,
    ' RBPROBRP.FRM, RBSCRN.FRM

    Dim RB_err As Integer
    Dim RB_error As String
    Dim RB_errl As Long
    Dim RB_Msg As String
    RB_err = Err
    RB_error = Error$
    RB_errl = Erl
    SndPlaySound "crash.wav", 2
    Beep
    RB_Msg = "A " & RB_error & " error (" & RB_err & ") has occurred"
    If RB_errl <> 0 Then
        RB_Msg = RB_Msg & " at line " & RB_errl
    End If
    RB_Msg = RB_Msg + " in routine " & proutine & " of form " & pform
    RB_Msg = RB_Msg & "."
    If RB_err = 3051 Then
        RB_Msg = RB_Msg & "  This error is usually caused because another user on the network, "
        RB_Msg = RB_Msg & "another function on this workstation, is performing a function that "
        RB_Msg = RB_Msg & "requires exclusive use of the indicated file."
    End If
    RBErrFrm.Msg.Text = RB_Msg & Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & "Press Help for more information"
    RBErrFrm.SvErr.Caption = RB_err
    RBErrFrm.Show MODAL
    Select Case RB_Erraction
    Case 0
        End
    Case 1
        RB_ErrorHandler = RB_Erraction
    Case 2
        RB_ErrorHandler = RB_Erraction
    End Select

End Function

Sub RB_LogTask (psTask As String, psForm As String, piFunction As Integer, psComments As String)
    ' Log task performance information
    ' psTask = Name of task being performed
    ' psForm = Name of form task being performed from
    ' piFunction = RB_STARTTASK to indicate the start of a task or
    '              RB_ENDTASK to indicate the end of a task
    ' psComments = any additional information regarding task

    Dim iSetEnd As Integer, dduration As Double
    Dim erraction As Integer

    On Error GoTo LogTaskErr

    If Not RB_LogFileOpen Or Not RB_LogPerformanceData Then
        Exit Sub
    End If
    iSetEnd = False
    If piFunction = RB_ENDTASK Then
        iSetEnd = True
    End If
    If Not RB_TblPerformanceLog.EOF Then
        If IsNull(RB_TblPerformanceLog![End Date/Time]) Then
            iSetEnd = True
        End If
    End If
    If iSetEnd Then
        RB_TblPerformanceLog.Edit
        RB_TblPerformanceLog![End Date/Time] = Now
        dduration = (RB_TblPerformanceLog![End Date/Time] - RB_TblPerformanceLog![Start Date/Time]) / TimeSerial(0, 0, 1)
        RB_TblPerformanceLog!Duration = dduration
        If psComments <> "" Then
            RB_TblPerformanceLog!comments = psComments
        End If
        RB_TblPerformanceLog.Update
    End If
    If piFunction = RB_STARTTASK Then
        RB_TblPerformanceLog.AddNew
        RB_TblPerformanceLog![User Name] = RB_UserName
        On Error Resume Next
        RB_TblPerformanceLog![System/Version] = RB_systemname & "/" & RB_version
        On Error GoTo LogTaskErr
        RB_TblPerformanceLog![Form Name] = psForm
        RB_TblPerformanceLog!Task = psTask
        RB_TblPerformanceLog![Start Date/Time] = Now
        RB_TblPerformanceLog!comments = psComments
        RB_TblPerformanceLog.Update         ' Make sure the row is added
        RB_TblPerformanceLog.Bookmark = RB_TblPerformanceLog.LastModified   ' Get back to row just added
    End If

    Exit Sub

LogTaskErr:
    erraction = RB_ErrorHandler("RDBLIB.BAS", "RB_LogTask")
    Select Case erraction
    Case 1
        Resume 0      ' Retry option selected
    Case 2
        Resume Next   ' Ignore option selected
    End Select


End Sub

Sub RB_OpenLog ()
    Dim logmdbloc As String      ' Log file location
    Dim IniFileName$, AppName$, KeyName$, DefaultStr$
    Dim nSize%, Numeric%, nDefault, ReturnStr$, sel_button As Integer
    Dim erraction As Integer, temp As String

    On Error GoTo OpenLogErr

    IniFileName$ = "RDBLOG.INI"        'name of ini file
    AppName$ = "Logging Parameters"     'Name of application or section heading
    KeyName$ = "Database Location"          'Keyword or variable name
    DefaultStr$ = ""            'Default string        (for String variables)
    nSize% = 255                'uncertain - possibly length of fill string
    Numeric% = False               'Tell it we are looking for a string
    ReadIni AppName$, KeyName$, nDefault, DefaultStr$, ReturnStr$, Numeric%, IniFileName$
    logmdbloc = Trim$(ReturnStr$) & "rdblog.mdb"
    If logmdbloc = "" Then
        RB_LogFileOpen = False
        RB_LogPerformanceData = False
        Exit Sub
    End If

    On Error Resume Next
    temp = Dir$(logmdbloc)
    If Err = 0 And temp <> "" Then
        On Error GoTo OpenLogErr
        Set RB_DBLog = OpenDatabase(logmdbloc)
        Set RB_TblErrorLog = RB_DBLog.OpenTable("Error Log")
        Set RB_TblPerformanceLog = RB_DBLog.OpenTable("Performance Data")
        RB_LogFileOpen = True
        KeyName$ = "Log Performance Data"          'Keyword or variable name
        DefaultStr$ = ""            'Default string        (for String variables)
        ReadIni AppName$, KeyName$, nDefault, DefaultStr$, ReturnStr$, Numeric%, IniFileName$
        If ReturnStr$ = "True" Then
            RB_LogPerformanceData = True
        Else
            RB_LogPerformanceData = False
        End If
    Else
        RB_LogFileOpen = False
        RB_LogPerformanceData = False
    End If
    KeyName$ = "User Name"          'Keyword or variable name
    DefaultStr$ = ""            'Default string        (for String variables)
    nSize% = 255                'uncertain - possibly length of fill string
    Numeric% = False               'Tell it we are looking for a string
    ReadIni AppName$, KeyName$, nDefault, DefaultStr$, ReturnStr$, Numeric%, IniFileName$
    RB_UserName = ReturnStr$
    On Error GoTo OpenLogErr

    Exit Sub

OpenLogErr:
    erraction = RB_ErrorHandler("RDBLIB.BAS", "RB_OpenLog")
    Select Case erraction
    Case 1
        Resume 0      ' Retry option selected
    Case 2
        Resume Next   ' Ignore option selected
    End Select

End Sub